home *** CD-ROM | disk | FTP | other *** search
/ BCI NET 2 / BCI NET 2.iso / archives / programming / languages / obrn-a_1.5_lib.lha / oberon-a / source2.lha / Source / Library / Math.mod < prev    next >
Encoding:
Text File  |  1995-01-26  |  3.3 KB  |  168 lines
  1. (*************************************************************************
  2.  
  3.      $RCSfile: Math.mod $
  4.   Description: Basic functions for REALs.
  5.  
  6.    Created by: fjc (Frank Copeland)
  7.     $Revision: 1.4 $
  8.       $Author: fjc $
  9.         $Date: 1995/01/26 00:40:27 $
  10.  
  11.   Copyright © 1994-1995, Frank Copeland.
  12.   This file is part of the Oberon-A Library.
  13.   See Oberon-A.doc for conditions of use and distribution.
  14.  
  15.   Thanks to Mike Griebling and Rene Hogendoorn for their assistance.
  16.  
  17. *************************************************************************)
  18.  
  19. <* MAIN- *> <* INITIALISE- *> <*$LongVars+*> <*$ReturnChk-*>
  20.  
  21. MODULE Math;
  22.  
  23. IMPORT m1 := MathIeeeSingBas, m2 := MathIeeeSingTrans;
  24.  
  25. CONST
  26.   pi *= 3.14159265358979323846;
  27.   e  *= 2.71828182845904523536;
  28.  
  29.  
  30. PROCEDURE sqrt * ( x : REAL ) : REAL;
  31. BEGIN (* sqrt *)
  32.   RETURN m2.Sqrt (x)
  33. END sqrt;
  34.  
  35.  
  36. PROCEDURE power * ( x, base : REAL ) : REAL;
  37. BEGIN (* power *)
  38.   RETURN m2.Pow (base, x)
  39. END power;
  40.  
  41.  
  42. PROCEDURE exp * ( x : REAL ) : REAL;
  43. BEGIN (* exp *)
  44.   RETURN m2.Exp (x)
  45. END exp;
  46.  
  47.  
  48. PROCEDURE ln * ( x : REAL ) : REAL;
  49. BEGIN (* ln *)
  50.   RETURN m2.Log (x)
  51. END ln;
  52.  
  53.  
  54. PROCEDURE log * ( x, base : REAL ) : REAL;
  55. BEGIN (* log *)
  56.   RETURN m2.Log (x) / m2.Log (base)
  57. END log;
  58.  
  59.  
  60. PROCEDURE round * ( x : REAL ) : REAL;
  61. BEGIN (* round *)
  62.   IF x < 0.0 THEN RETURN m1.Ceil (x - 0.5)
  63.   ELSE RETURN m1.Floor (x + 0.5)
  64.   END
  65. END round;
  66.  
  67.  
  68. PROCEDURE sin * ( x : REAL ) : REAL;
  69. BEGIN (* sin *)
  70.   RETURN m2.Sin (x)
  71. END sin;
  72.  
  73.  
  74. PROCEDURE cos * ( x : REAL ) : REAL;
  75. BEGIN (* cos *)
  76.   RETURN m2.Cos (x)
  77. END cos;
  78.  
  79.  
  80. PROCEDURE tan * ( x : REAL ) : REAL;
  81. BEGIN (* tan *)
  82.   RETURN m2.Tan (x)
  83. END tan;
  84.  
  85.  
  86. PROCEDURE arcsin * ( x : REAL ) : REAL;
  87. BEGIN (* arcsin *)
  88.   RETURN m2.Asin (x)
  89. END arcsin;
  90.  
  91.  
  92. PROCEDURE arccos * ( x : REAL ) : REAL;
  93. BEGIN (* arccos *)
  94.   RETURN m2.Acos (x)
  95. END arccos;
  96.  
  97.  
  98. PROCEDURE arctan * ( x : REAL ) : REAL;
  99. BEGIN (* arctan *)
  100.   RETURN m2.Atan (x)
  101. END arctan;
  102.  
  103.  
  104. PROCEDURE arctan2 * ( xn, xd : REAL ) : REAL;
  105.  
  106.   CONST piBy2 = 1.57079632679489161923;
  107.   VAR res : REAL;
  108.  
  109. BEGIN
  110.   IF xd = 0.0 THEN
  111.     IF xn = 0.0 THEN RETURN 0.0
  112.     ELSE IF xn < 0.0 THEN RETURN -piBy2 ELSE RETURN piBy2 END
  113.     END
  114.   (* Checking for Overflow/Underflow at this point appears unnecessary,
  115.      as testing without the checks seems to produce the correct results.
  116.      [Possibly 'famous last words' by fjc :-)]
  117.   ELSIF Overflow(xn/xd) THEN
  118.     IF xn < 0.0 THEN RETURN -piBy2 ELSE RETURN piBy2 END
  119.   ELSIF Underflow(xn/xd) THEN res := 0.0
  120.   *)
  121.   ELSE res := arctan(ABS(xn/xd))
  122.   END;
  123.   IF xd < 0.0 THEN res := pi - res END; (* Is this right? *)
  124.   IF xn < 0.0 THEN RETURN -res ELSE RETURN res END
  125. END arctan2;
  126.  
  127.  
  128. PROCEDURE sinh * ( x : REAL ) : REAL;
  129. BEGIN (* sinh *)
  130.   RETURN m2.Sinh (x)
  131. END sinh;
  132.  
  133.  
  134. PROCEDURE cosh * ( x : REAL ) : REAL;
  135. BEGIN (* cosh *)
  136.   RETURN m2.Cosh (x)
  137. END cosh;
  138.  
  139.  
  140. PROCEDURE tanh * ( x : REAL ) : REAL;
  141. BEGIN (* tanh *)
  142.   RETURN m2.Tanh (x)
  143. END tanh;
  144.  
  145. (* Sanity checking should be added to these procedures [fjc] *)
  146.  
  147. PROCEDURE arcsinh * ( x : REAL ) : REAL;
  148. BEGIN (* arcsinh *)
  149.   RETURN m2.Log (x + m2.Sqrt (x * x + 1.0))
  150. END arcsinh;
  151.  
  152.  
  153. PROCEDURE arccosh * ( x : REAL ) : REAL;
  154. BEGIN (* arccosh: x >= 1.0 *)
  155.   RETURN m2.Log (x + m2.Sqrt (x * x - 1.0))
  156. END arccosh;
  157.  
  158.  
  159. PROCEDURE arctanh * ( x : REAL ) : REAL;
  160. BEGIN (* arctanh: 0 <= x*x <= 1 *)
  161.   RETURN 0.5 * m2.Log ((1.0 + x) / (1.0 - x))
  162. END arctanh;
  163.  
  164.  
  165. BEGIN
  166.   ASSERT (m1.base # NIL, 100); ASSERT (m2.base # NIL, 100)
  167. END Math.
  168.